CATIA VBA 测量距离

2023-04-08 00:02| 来源: 网络整理| 查看: 265

原文链接

因为CATIA V5 的测量工具接口未暴露给VBA; 因此宏记录器不会记录测量代码. 但是我们可以用别的方式，使用VBA实现测距功能.

测量工具接口未暴露给VBA

方法1 参数、关系法

（经测试，此方式不能测量多个Part间元素的距离）第一步，创建参数和关系。在我们写代码以前，最好先手工操作一下，这样更加便于我们准确理解整个流程。以下是手工操作步骤：

1.创建类型为Length的参数，保持默认值0mm，当然也可以自定义参数名称。

catia parameter length macros

2.点击添加公式

3. 找到左侧的Measure，然后选择 distance (Body, Body); Length

catia formula editor

4. 选择您想测量的2个图形元素（可以是Objects也可以是特征）。大功告成！以下为相应代码：

'this macro creates a parameter and relation to measure the distance between two points Language="VBSCRIPT" Sub CATMain() 'active document is a single part file' Dim partDocument1 As Document Set partDocument1 = CATIA.ActiveDocument Dim part1 As Part Set part1 = partDocument1.Part Dim parameters1 As Parameters Set parameters1 = part1.Parameters 'create a new length type parameter, set its value to 0 for now' Dim length1 As Dimension Set length1 = parameters1.CreateDimension("", "LENGTH", 0.000000) 'if you want to rename the parameter' length1.Rename "MeasureDistance" 'create a new formula to link to the parameter' Dim relations1 As Relations Set relations1 = part1.Relations 'make sure points are labeled MyEndPt1 and MyEndPt2 respectively' Dim formula1 As Formula Set formula1 = relations1.CreateFormula("Formula.2", "", length1, "distance(`Geometrical Set.1\MyEndPt1` ,`Geometrical Set.1\MyEndPt2` ) ") 'rename the formula' formula1.Rename "Distance" 'display the distance the endpoints are apart in a messagebox' Msgbox "The endpoints are " ; length1.ValueAsString ; " apart." End Sub

测试的CATPart 结构树如下图。注意下面的参数和关系是程序刚刚创建的（绿色的测量是手工创建的，目的是验证程序的准确性）。

how to measure distance between two points catia

上面这段代码除了可以测量两个点的距离，也可以用来测量点面间距，只需要把代码稍作修改：

Set formula1 = relations1.CreateFormula("Formula.2", "", length1, "distance(`Geometrical Set.1\MyEndPt1` ,`Geometrical Set.1\MyEndPt2` ) ")

改成：

Set formula1 = relations1.CreateFormula("Formula.2", "", length1, Distance(‘Geometrical Set.1\MyEndPt1’ , ‘Geometrical Set.1\Plane.1’)") **方法2 SPAWORKBENCH **

另外一个方法是使用SPAWorkbench 属性及方法，但前提是CATIA需要有DMU授权，否则，这个接口不能使用。以下为参考代码

Sub CATMain() 'active document must be a CATPart Dim documents1 As Documents Set documents1 = CATIA.Documents Dim pDocument1 As PartDocument Set pDocument1 = CATIA.ActiveDocument Dim part1 As Part Set part1 = pDocument1.Part Dim hybridBodies1 As HybridBodies Set hybridBodies1 = part1.HybridBodies Dim reference1 As Reference Dim hybridBody1 As HybridBody Set hybridBody1 = hybridBodies1.Item(1) Set hybridShapes1 = hybridBody1.HybridShapes Set reference1 = hybridShapes1.Item("MyEndPt1") 'if code not working properly use msgbox to check reference name 'MsgBox ("ref1=" ; reference1.Name) Dim reference2 As Reference Set reference2 = hybridShapes1.Item("MyEndPt2") 'built in check if needed 'MsgBox ("ref2=" ; reference2.Name) 'get the SPAworkbench Dim TheSPAWorkbench As Workbench Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") Dim TheMeasurable As Measurable Set TheMeasurable = TheSPAWorkbench.GetMeasurable(reference1) Dim MinimumDistance As Double MinimumDistance = TheMeasurable.GetMinimumDistance(reference2) 'display the result MsgBox MinimumDistance End Sub

spaworkbench measure

P.S. GetWorkbench 命令输入一个string，返回一个 Workbench 对象. 在CATIA里，每个Workbench都有一个对应的ID.

原文链接

如果建立Group，是否也可测量Group的距离？如果有朋友了解Group，欢迎留言讨论: 以下代码未做测试，仅为猜想：

Dim MyDoc As Document Set MyDoc = CATIA.ActiveDocument Dim MainProduct As Product Set MainProduct = MyDoc.Product Dim product1 As Product Dim product2 As Product Set product1 = MainProduct.Products.Item("Part1.1") Set product2 = MainProduct.Products.Item("Part2.1") Dim FirstGroup As Group Dim cGroups As Groups Set cGroups = CATIA.ActiveDocument.Product.GetTechnologicalObject("Groups") Dim oGroup1 As Group Dim oGroup2 As Group Set oGroup1 = cGroups.Add Set oGroup2 = cGroups.Add Dim cDistances As Distances Set cDistances = CATIA.ActiveDocument.Product.GetTechnologicalObject("Distances") Dim NewDistance As Distance Set NewDistance = cDistances.Add oGroup1.AddExplicit product1 oGroup2.AddExplicit product2 NewDistance.FirstGroup = oGroup1 NewDistance.SecondGroup = oGroup2 NewDistance.ComputationType = catDistanceComputationTypeBetweenTwo NewDistance.MeasureType = catDistanceMeasureTypeMinimum NewDistance.Compute MsgBox NewDistance.Value

测量一个Product下不同Part元素的距离

原文链接

以下代码主要依靠CreateReferenceFromName，注意他的参数的写法，详见如下：

' create reference to a point on the assembly level' Dim refCLP As Reference 'OLD CODE: Set refCLP = ClampPart.CreateReferenceFromObject(ClampLocationPoint)' Set refCLP = main_prod.CreateReferenceFromName(main_prod.PartNumber & "/" & prod1.Name & "/" & prods.Item(1).Name & "/!Point1") Dim TheSPAWorkbench As Workbench Set TheSPAWorkbench = catia.ActiveDocument.GetWorkbench("SPAWorkbench") Dim TheMeasurable 'As Measurable' Dim Coordinates(8) Dim min_dist As Double Dim MainAssyPart As Part Set MainAssyPart = main_prods.Item(2).ReferenceProduct.Parent.Part Dim AssyPartOrigin Set AssyPartOrigin = MainAssyPart.FindObjectByName("OPoint") ' create reference to origin point (on the assembly level)' Dim refAPO As Reference Set refAPO = main_prod.CreateReferenceFromName(main_prod.PartNumber & "/" & main_prods.Item(2).Name & "/!OPoint") 'OLD CODE: Dim refAxisOrigin As Reference' 'OLD CODE: Set refAxisOrigin = MainAssyPart.CreateReferenceFromObject(AssyPartOrigin)' 'OLD CODE: Set TheMeasurable = TheSPAWorkbench.GetMeasurable(ClampLocationPoint)' 'OLD CODE: TheMeasurable.GetMinimumDistancePoints refAxisOrigin, Coordinates' Set TheMeasurable = TheSPAWorkbench.GetMeasurable(refAPO) ' measure distance between two points (from AssyPartOrigin to ClampLocationPoint)' Dim dDistance ' as Double' dDistance = TheMeasurable.GetMinimumDistance(refCLP)

【本文地址】

公司简介

联系我们